home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / ctodsk.act < prev    next >
Text File  |  1995-04-22  |  5KB  |  286 lines
  1.  
  2. MODULE ; CMPTODSK.ACT
  3.  
  4. ; Copyright (c) 1983
  5. ; by Action Computer Services
  6. ; All Rights Reserved
  7.  
  8. ; version 1.0
  9. ; last modified October 22, 1984
  10.  
  11. ; Compile to disk for ACTION! 
  12. ; compiler.  Note that all ARRAY
  13. ; declarations that generate storage
  14. ; must be before the first procedure
  15. ; declaration or else the address of
  16. ; the storage will not be setup
  17. ; correctly (all dimensioned ARRAYs
  18. ; which are not assigned an initial
  19. ; value except BYTE/CHAR arrays of
  20. ; size 256 or less).  Local ARRAY
  21. ; declarations in the main PROC (last
  22. ; procedure in program) are also
  23. ; allowed.  Note:  there must be at 
  24. ; least one PROC/FUNC in program.
  25.  
  26. ; Output file name will be same name
  27. ; as program being compiled with
  28. ; extention .OBJ
  29.  
  30. ; IF AN ERROR OCCURS DURING
  31. ; COMPILATION, YOU SHOULD USE
  32. ; "/" to close all open files:
  33. ;      >/
  34.  
  35. ; change dev in SPLEnd below to direct
  36. ; output to printer.
  37.  
  38. DEFINE STRING = "CHAR ARRAY"
  39. DEFINE JMP = "$4C" ; JMP addr16
  40.  
  41. TYPE INSTR=[BYTE op CARD addr]
  42. INSTR Segvec=$4C6
  43. INSTR SPLvec=$4DD
  44. INSTR MonCmd=$4FB
  45. INSTR OldMon
  46.  
  47. BYTE oldDevice, curBank=$4C9
  48. BYTE pf, Zop=$8A, tZop, dev
  49. CARD curproc=$8E, code=$E
  50. CARD codeBase=$491, codeSize=$493
  51. CARD codeOff=$B5
  52. CARD globals, gsize
  53. CARD totalSize, codeStart
  54. CHAR ARRAY cmdLine(0)=$590
  55. BYTE ARRAY bank(0)=$D500
  56. BYTE ARRAY zpage(32), temps(16)
  57.  
  58.  
  59. PROC InitMon()
  60. ; add "/" command to monitor which
  61. ; closes channels 1-5 and warm
  62. ; starts cartridge.
  63.  
  64.   CHAR cmdchar=$591
  65.   BYTE i, WARMST=$8
  66.   DEFINE JMPI="$6C"
  67.  
  68. ; make sure right command
  69.   IF cmdchar#'/ THEN [JMP OldMon] FI
  70.  
  71.   bank(0) = 0 ; init library routines
  72.   FOR i = 1 TO 5 DO
  73.     Close(i)
  74.   OD
  75.  
  76.   WARMST = 1
  77. [JMPI $BFFA] ; warm start cart.
  78.  
  79.  
  80. INCLUDE "BLKIO.ACT"
  81.  
  82.  
  83. PROC Save()
  84. ; save state of variables used by
  85. ; both compiler and library routines
  86.  
  87.   bank(0) = 0 ; init library routines
  88.   tZop = Zop
  89.   MoveBlock(zpage, $B0, $1B) ; to $CA
  90.   MoveBlock(temps, $5F0, 16)
  91. RETURN
  92.  
  93.  
  94. PROC Restore()
  95. ; restore state of variables used by
  96. ; both compiler and library routines
  97.   CARD tcodeOff
  98.  
  99.   Zop = tZop
  100.   tcodeOff = codeOff
  101.   MoveBlock($B0, zpage, $1B) ; to $CA
  102.   MoveBlock($5F0, temps, 16)
  103.   codeOff = tcodeOff
  104.  
  105.   bank(curBank) = 0
  106. RETURN
  107.  
  108.  
  109. PROC WriteHdr()
  110.   PutCD(5, $FFFF)
  111.   PutCD(5, codeStart)
  112.   PutCD(5, codeStart+totalSize-1)
  113.   WriteBlock(5, globals, gsize)
  114. RETURN
  115.  
  116.  
  117. PROC WriteCode()
  118.   codeSize = code - codeBase
  119.   PrintD(dev, curproc)
  120.   PrintD(dev, ": ")
  121.   PrintCDE(dev, codeSize)
  122.   totalSize = totalSize + codeSize
  123.   WriteBlock(5, codeBase, codeSize)
  124.   code = codeBase
  125.   codeOff = codeOff + codeSize
  126. RETURN
  127.  
  128.  
  129. PROC SegEnd()
  130.   Save()
  131.   IF pf THEN ; print locals
  132.     WriteCode()
  133.   ELSE
  134.     pf = 1
  135.     globals = codeBase
  136.     gsize = code - codeBase
  137.     codeBase = code
  138.     totalSize = gsize
  139.     codeStart = globals + codeOff
  140.     WriteHdr()
  141.   FI
  142.   Restore()
  143. RETURN
  144.  
  145.  
  146. PROC SPL() ; dummy proc for call below
  147.  
  148.  
  149. PROC SPLEnd()
  150.   CHAR c
  151.   BYTE nxttoken=$D3, i, n, buf=$9B^
  152.   CARD nxtaddr=$C9, start=$2E2
  153.   STRING inbuf(0)=$5C8, name
  154.   STRING out(17)
  155.  
  156.   DEFINE PLA = "$68",
  157.          STA = "$8D"
  158.  
  159.   Save()
  160.  
  161.   dev = 0
  162. ; to get output to printer:
  163. ; dev = 4
  164. ; Close(4)  Open(4, "P:", 8, 0)
  165.  
  166. ; get output name
  167.   IF nxttoken=30 THEN ; command line
  168.     name = nxtaddr
  169.   ELSE ; editor buffer
  170.     name = inbuf
  171.   FI
  172.  
  173. ; see if device needed
  174.   n = 0
  175.   IF name(2)#': AND name(3)#': THEN
  176.     out(1) = 'D   out(2) = ':  n = 2
  177.   FI
  178.  
  179. ; get name without extension
  180.   FOR i = 1 TO name(0) DO
  181.     c = name(i)
  182.     IF c='. THEN EXIT FI
  183.     IF c>'Z THEN c = c & $5F FI
  184.     out(i+n) = c   
  185.   OD
  186.  
  187. ; add extension
  188.   out(i+n) = '.
  189.   out(i+n+1) = 'O
  190.   out(i+n+2) = 'B
  191.   out(i+n+3) = 'J
  192.   out(0) = i + n + 3
  193.  
  194.   PutE()
  195.   Print("output file is ")
  196.   PrintE(out)
  197.   PutE()
  198.  
  199.   Close(5)  Open(5, out, 8, 0)
  200.   buf = 0 ; clear buf used by Open
  201.  
  202.   pf = 0 ; no proc decl yet
  203.  
  204. ; JSR for return so that we come
  205. ; back here after compilation
  206.   [   
  207.     PLA
  208.     STA SPL+1
  209.     PLA
  210.     STA SPL+2
  211.   ]
  212.   SPL = SPL + 1 ; get right address
  213.   Restore()
  214.  
  215.   SPL()
  216.  
  217.   Save()
  218.  
  219. ; ignore space for arrays
  220.   code = codeBase + codeSize
  221.  
  222.   WriteCode()
  223.   PutCD(5, $2E2)
  224.   PutCD(5, $2E3)
  225.   PutCD(5, start)
  226.   Close(5)
  227.  
  228.   Open(5, out, $C, 0)
  229.   WriteHdr()
  230.   Close(5)
  231.  
  232.   PutDE(dev)
  233.   PrintCD(dev, totalSize)
  234.   PrintDE(dev, " bytes of code")
  235.  
  236.   Restore()
  237.   codeOff = 0
  238. RETURN
  239.  
  240.  
  241. ; only code generated before Init is
  242. ; allocated space.  Init will be
  243. ; garbage collected (well kind of).
  244.  
  245. PROC Init()
  246.   CARD codeBlock, bsize, csize, nBlock
  247.   CARD POINTER cur, next
  248.  
  249. ; link in our routines
  250.   Segvec.op = JMP
  251.   Segvec.addr = SegEnd
  252.   SPLvec.op = JMP
  253.   SPLvec.addr = SPLEnd
  254.   OldMon.op = MonCmd.op
  255.   OldMon.addr = MonCmd.addr
  256.   MonCmd.op = JMP
  257.   MonCmd.addr = InitMon
  258.  
  259. ; allocate our routine so it won't
  260. ; go away.
  261.   codeBlock = codeBase - 4
  262.   next = $80 ; AFbase
  263.   DO
  264.     cur = next
  265.     next = next^
  266.   UNTIL next=0 OR next=codeBlock OD
  267.  
  268.   IF next=0 THEN
  269.     PutE()   Put($FD)
  270.     PrintE("I can't allocate space for your code")
  271.     PrintE("You better Boot and try again!")
  272.     RETURN
  273.   FI
  274.  
  275. ; assume we can split block
  276.   csize = @codeBlock-codeBlock
  277.   nBlock = next^
  278.   bsize = next(1) - csize
  279.   next = @codeBlock
  280.   cur^ = next
  281.   next^ = nBlock
  282.   next(1) = bsize
  283.   codeBase = next + 4
  284. RETURN
  285.  
  286.